# Coverage: Manipulation of "server addresses".
#
# $Id$

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import ::tcltest::*
}

package require dbus

# Constraints
#testConstraint have_mmap 0

# "Tree comparator":
source [file join [file dir [info script]] tc.tcl]

# Reference error messages:
set errmsg_value "Malformed server address value"
set errmsg_addr  "Malformed server address"

# Escaping and unescaping of "server address values":

# Escaping:

test escape-1.1 {String of optionally-escaped characters passes as-is} -body {
	::dbus::EscapeAddressValue \
		{-./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ\_abcdefghijklmnopqrstuvwxyz}
} -result {-./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ\_abcdefghijklmnopqrstuvwxyz}

test escape-1.2 {Escaping of "special" characters in range 0..127} -body {
	set in  ""
	set out ""
	foreach {from to} {
		0x00 0x2C
		0x3A 0x40
		0x5B 0x5B
		0x5D 0x5E
		0x60 0x60
		0x7B 0x7F
	} {
		for {set n $from} {$n <= $to} {incr n} {
			append in [format %c $n]
			append out % [format %02x $n]
		}
	}
	string equal -nocase [::dbus::EscapeAddressValue $in] $out
} -result 1

test escape-1.3 {Escaping of Cyrillic string} -body {
	::dbus::EscapeAddressValue \u0430\u0431\u0432\u0433\u0434
} -result %d0%b0%d0%b1%d0%b2%d0%b3%d0%b4 

test escape-1.4 {Escaping of Hiragana string} -body {
	::dbus::EscapeAddressValue \u3041\u3042\u3043\u3044
} -result %e3%81%81%e3%81%82%e3%81%83%e3%81%84

# Unescaping:

test unescape-1.1 {String of optionally-escaped characters passes as-is} -body {
	::dbus::UnescapeAddressValue \
		{-./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ\_abcdefghijklmnopqrstuvwxyz}
} -result {-./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ\_abcdefghijklmnopqrstuvwxyz}

test unescape-1.2 {Unescaping of "special" characters in range 0..127} -body {
	set in  ""
	set out ""
	foreach {from to} {
		0x00 0x2C
		0x3A 0x40
		0x5B 0x5B
		0x5D 0x5E
		0x60 0x60
		0x7B 0x7F
	} {
		for {set n $from} {$n <= $to} {incr n} {
			append in [format %c $n]
			append out % [format %02x $n]
		}
	}
	string equal -nocase [::dbus::UnescapeAddressValue $out] $in
} -result 1

test unescape-1.3 {Unescaping of Cyrillic string} -body {
	::dbus::UnescapeAddressValue %d0%b0%d0%b1%d0%b2%d0%b3%d0%b4 
} -result \u0430\u0431\u0432\u0433\u0434

test unescape-1.4 {Unescaping of Hiragana string} -body {
	::dbus::UnescapeAddressValue %e3%81%81%e3%81%82%e3%81%83%e3%81%84
} -result \u3041\u3042\u3043\u3044

test unescape-1.5 {Minimal valid escaped string} -body {
	::dbus::UnescapeAddressValue %20
} -result \x20

test unescape-1.6 {Escaped optionally-escaped characters} -body {
	::dbus::UnescapeAddressValue %41%42%43%78%79%7A%2F%5F
} -result ABCxyz/_

test unescape-1.7 {Mixed case of hexnums doesn't matter} -body {
	::dbus::UnescapeAddressValue %d0%B0%D0%b1%D0%b2%D0%B3%d0%B4 
} -result \u0430\u0431\u0432\u0433\u0434

test unescape-1.8 {Mixing normal and escaped characters} -body {
	::dbus::UnescapeAddressValue ABC%d0%B0de%D0%b1/.\\%D0%b2_%D0%B3-%d0%B4%25
} -result ABC\u0430de\u0431/.\\\u0432_\u0433-\u0434%

# Unescaping of malformed strings:

test unescape-2.1 {Single % character} -body {
	::dbus::UnescapeAddressValue %
} -returnCodes error -result $errmsg_value

test unescape-2.2 {One hexnum after %} -body {
	::dbus::UnescapeAddressValue %a
} -returnCodes error -result $errmsg_value

test unescape-2.3 {One hexnum after % in normal string} -body {
	::dbus::UnescapeAddressValue aaa%axyzzy
} -returnCodes error -result $errmsg_value

test unescape-2.4 {Non-optionally-escaped characters in a string} -body {
	::dbus::UnescapeAddressValue ABDC(and)this
} -returnCodes error -result $errmsg_value

test unescape-2.5 {Non-optionally-escaped characters in a string} -body {
	::dbus::UnescapeAddressValue ABDC\u3045xyzzy
} -returnCodes error -result $errmsg_value

test unescape-2.6 {Non-optionally-escaped characters in a string} -body {
	set s ""
	for {set n 0} {$n < 0x04FF} {incr n} {
		set c [format %c $n]
		if {[regexp {^[0-9A-Za-z/.\\_-]$} $c]} continue
		if {![catch { ::dbus::UnescapeAddressValue $c } out]} {
			append s < $c > -> < $out >
		}
	}
	return $s
} -result ""

# Parsing of server addresses:

test parse-1.1 {Simple address} -body {
	tc \
		[::dbus::ParseServerAddress unix:path=/var/foo/bar/baz] \
		{unix {path /var/foo/bar/baz}}
} -result 1

test parse-1.2 {Address with two values} -body {
	tc \
		[::dbus::ParseServerAddress \
			unix:path=/var/foo/bar/baz,guid=039iabd37ds28920] \
		{unix {path /var/foo/bar/baz guid 039iabd37ds28920}}
} -result 1

test parse-1.3 {Extraneous semicolons are ignored} -body {
	tc \
		[::dbus::ParseServerAddress \
			{;unix:path=/var/foo/bar/baz,guid=039iabd37ds28920;}] \
		{unix {path /var/foo/bar/baz guid 039iabd37ds28920}}
} -result 1

test parse-1.4 {Two addresses} -body {
	tc \
		[::dbus::ParseServerAddress \
			{unix:abstract=/tmp/328hbdhb;tcp:host=microsoft.com,port=438,family=ipv4}] \
		{unix {abstract /tmp/328hbdhb} tcp {host microsoft.com port 438 family ipv4}}
} -result 1

test parse-2.1 {Escaped value} -body {
	tc \
		[::dbus::ParseServerAddress \
			unix:path=/home/vasya/%d1%81%d0%b2%d0%b5%d1%82%d0%bb%d1%8b%d0%b9/%d0%bf%d1%83%d1%82%d1%8c,guid=039iabd37ds28920] \
		{unix {path /home/vasya/\u0441\u0432\u0435\u0442\u043b\u044b\u0439/\u043f\u0443\u0442\u044c guid 039iabd37ds28920}}
} -result 1

test parse-2.2 {Parser doesn't get screwed on repeated = in value} -body {
	::dbus::ParseServerAddress unix:path=/some/wrong=path,guid=18fe829ac2889
} -returnCodes error -result $errmsg_value

test parse-3.1 {No colon in address} -body {
	::dbus::ParseServerAddress foobar
} -returnCodes error -result $errmsg_addr

test parse-3.2 {Empty method} -body {
	::dbus::ParseServerAddress :path=/var/run/bus
} -returnCodes error -result $errmsg_addr

test parse-3.3 {Empty key} -body {
	::dbus::ParseServerAddress unix:=/var/run/bus
} -returnCodes error -result $errmsg_addr

test parse-3.4 {Empty value #1} -body {
	::dbus::ParseServerAddress unix:path=
} -returnCodes error -result $errmsg_addr

test parse-3.5 {Empty value #2} -body {
	::dbus::ParseServerAddress unix:path=/var/run/bus,guid=
} -returnCodes error -result $errmsg_addr

test parse-3.5 {Empty value #3} -body {
	::dbus::ParseServerAddress unix:=/var/run/bus,guid=398a3b49
} -returnCodes error -result $errmsg_addr

test parse-3.6 {Stray comma #1} -body {
	::dbus::ParseServerAddress unix:path=/var/run/bus,
} -returnCodes error -result $errmsg_addr

test parse-3.7 {Stray comma #2} -body {
	::dbus::ParseServerAddress unix:,path=/var/run/bus
} -returnCodes error -result $errmsg_addr

test parse-3.8 {Stray comma #3} -body {
	::dbus::ParseServerAddress unix:,
} -returnCodes error -result $errmsg_addr

test parse-3.9 {Stray comma #4} -body {
	::dbus::ParseServerAddress unix:path=/var/run/bus,,guid=27687bc38efa3760
} -returnCodes error -result $errmsg_addr

# cleanup
::tcltest::cleanupTests
return

# vim:filetype=tcl
